home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Best of Shareware
/
Best of PC Windows Shareware 1.0 - Wayzata Technology (7111) (1993).iso
/
mac
/
DOS
/
PROGRAMG
/
FORTHCMP
/
HANOIMT.4TH
< prev
next >
Wrap
Text File
|
1992-03-30
|
8KB
|
303 lines
\ This program is Copyright (C) 1987 by Thomas Almy. All rights reserved.
\ This is an example program showing the operation of the multitasker.
\ It solves the Tower of Hanoi Puzzle using multiple tasks rather than
\ recursion or iteration!
\ The following options are appropriate on the ForthCMP command line:
\ 1 CONSTANT EGA 43 line EGA display
\ I80186 80186 or later processor type
\ 1 CONSTANT VID-DELAY IBM CGA (flicker problem)
200 SEPSSEG
10000 100 MSDOSEXE
NOMAP
INCLUDE MULTI \ Universal screen driver
\ INCLUDE MULTID \ IBM COMPATIBLE ( direct to display ) screen driver
DECIMAL
FIND FOREGROUND #IF DROP #ELSE
1 0 IN/OUT
: FOREGROUND DROP ( If not already defined, make into a noop ) ;
#THEN
FIND BACKGROUND #IF DROP #ELSE
1 0 IN/OUT
: BACKGROUND DROP ( If not already defined, make into a noop ) ;
#THEN
FIND l/s #IF DROP #ELSE 25 CONSTANT l/s #THEN \ lines per screen
l/s 25 > CONSTANT BIGSCREEN? \ pack it in??
1 1 IN/OUT
: 2** ( N -- 2**N )
1 SWAP 0 ?DO 2* LOOP ;
\ Offsets into HANOI messages
( offset zero is reserved for message pointer )
2 CONSTANT >INDX \ Index into solution
4 CONSTANT >RING \ ring number
6 CONSTANT >FROM \ source ring
8 CONSTANT >TO \ destination ring
10 CONSTANT >USE \ temp ring
VARIABLE DCOUNT \ extra taskswaps
1 0 IN/OUT
: SCRPOSITION ( index -- )
\ put cursor to appropriate index position
BIGSCREEN? #IF
\ there are 42 windows going down the screen and 13 windows across
0 l/s 1- UM/MOD 6 * SWAP GOTOXY ; ( position cursor )
#ELSE
\ there are 24 windows going down the screen, and seven windows across
0 l/s 1- UM/MOD 10 * SWAP GOTOXY ; ( position cursor )
#THEN
VARIABLE DCOUNTER
0 0 IN/OUT
: MESSAGE-PRINT ( a task )
7 BACKGROUND
BEGIN
GET-MESSAGE >R \ get message and save it
R@ >INDX @L SCRPOSITION \ position cursor
R@ >RING @L
DUP CASE 7 OF 15 ENDOF 8 OF 13 ENDOF 9 OF 12 ENDOF
DUP ENDCASE FOREGROUND
BIGSCREEN? #IF
ASCII 0 + EMIT ASCII # EMIT
#ELSE
ASCII # EMIT ASCII 0 + EMIT
SPACE
#THEN
R@ >FROM @L EMIT
BIGSCREEN? #IF
ASCII > EMIT
#ELSE
." ->"
#THEN
R@ >TO @L EMIT
R> FREE \ done with message
DCOUNT @ ?DUP IF \ wait a while??
DCOUNTER @ 1+ 7 AND DCOUNTER ! \ "randomize" the wait
DCOUNTER @ 8 + 12 */ 1+ WAIT
THEN
AGAIN
;
\ Allocate 12 tasks to run the above word
' MESSAGE-PRINT TASK PRNT1
' MESSAGE-PRINT TASK PRNT2
' MESSAGE-PRINT TASK PRNT3
' MESSAGE-PRINT TASK PRNT4
' MESSAGE-PRINT TASK PRNT5
' MESSAGE-PRINT TASK PRNT6
' MESSAGE-PRINT TASK PRNT7
' MESSAGE-PRINT TASK PRNT8
' MESSAGE-PRINT TASK PRNT9
' MESSAGE-PRINT TASK PRNT10
' MESSAGE-PRINT TASK PRNT11
' MESSAGE-PRINT TASK PRNT12
TABLE DSPTBL-P PRNT1 , PRNT2 , PRNT3 , PRNT4 , PRNT5 , PRNT6 , PRNT7 , PRNT8 ,
PRNT9 , PRNT10 , PRNT11 , PRNT12 ,
VARIABLE PINDEX \ current index into dispatch table
VARIABLE PCOUNT \ number of printer tasks to actually use
0 1 IN/OUT
: NEXT-PRINTER-TASK ( -- task )
\ gets address of the next printer task.
\ What we are trying to do is have all eight tasks printing at once!
\ This makes for one impressive display!
PINDEX @ DUP 1+ PCOUNT @ UMOD PINDEX ! \ count modulo PCOUNT
DSPTBL-P ;
: MAKE-MESSAGE ( index ring# from to using -- newMessage )
2 GET DUP >R \ make a new message, 16 bytes long
>USE !L \ store into all the fields
R@ >TO !L
R@ >FROM !L
R@ >RING !L
R@ >INDX !L
R> \ return message segment
;
0 1 IN/OUT NEED NEXT-HANOI-TASK
1 0 IN/OUT
: SEND-MESSAGES ( ourMessage -- )
DUP >R \ stash message on stack
\ calculate first message send
>INDX @L R@ >RING @L 1- 2** 2/ - \ new index
R@ >RING @L 1- \ new ring number
R@ >FROM @L \ new from
R@ >USE @L \ new to
R@ >TO @L \ new use
MAKE-MESSAGE \ create new message from this
NEXT-HANOI-TASK SEND-MESSAGE
\ calculate second message send
R@ >INDX @L R@ >RING @L 1- 2** 2/ + \ new index
R@ >RING @L 1- \ new ring number
R@ >USE @L \ new from
R@ >TO @L \ new to
R> >FROM @L \ new use
MAKE-MESSAGE
NEXT-HANOI-TASK SEND-MESSAGE
;
0 0 IN/OUT
: HANOI-TASK ( a task )
BEGIN
GET-MESSAGE \ get next execution message
DUP >RING @L 1 > IF \ high ring, send message to move lower rings
DUP SEND-MESSAGES THEN
NEXT-PRINTER-TASK SEND-MESSAGE \ send our message on to printer task
AGAIN
;
\ Allocate 6 tasks to run the above word
' HANOI-TASK TASK HAN1
' HANOI-TASK TASK HAN2
' HANOI-TASK TASK HAN3
' HANOI-TASK TASK HAN4
' HANOI-TASK TASK HAN5
' HANOI-TASK TASK HAN6
TABLE DSPTBL-H HAN1 , HAN2 , HAN3 , HAN4 , HAN5 , HAN6 ,
VARIABLE HINDEX \ current index into dispatch table
VARIABLE HCOUNT \ number of hanoi tasks to actually use
0 1 IN/OUT
: NEXT-HANOI-TASK ( -- task )
\ gets address of the next HANOI task.
HINDEX @ DUP 1+ HCOUNT @ UMOD HINDEX ! \ count modulo HCOUNT
DSPTBL-H ;
0 1 IN/OUT
: WAITING-TASKS ( -- N )
0 MAIN-TASK
BEGIN
DUP WAITING? IF SWAP 1+ SWAP THEN
DUP 2+ CS: @ + 4 + \ addr of next task
DUP MAIN-TASK = UNTIL
DROP
;
1 1 IN/OUT
: SETUP ( #rings -- message )
DUP 1- 2** 1- SWAP \ got index and ring number
ASCII A \ ring names
ASCII B
ASCII C
MAKE-MESSAGE ;
0 0 IN/OUT
: RUN-DOWN \ execute until only main and TASKCOUNT are active
ACTIVE-TASKS 2 = IF EXIT THEN \ nothing to wait for
0 l/s 1- GOTOXY 70 SPACES
0 l/s 1- GOTOXY ." waiting..."
0
BEGIN
ACTIVE-TASKS 2 > WHILE
1+ DUP 10 l/s 1- GOTOXY 6 U.R
REPEAT
DROP
;
: GET-COMMAND ( -- hcount pcount dcount ringcount OR 0 )
BIGSCREEN? #IF
0 l/s 1- GOTOXY ." NUMBER OF RINGS ( maximum is 9, default-QUIT):"
#ELSE
0 l/s 1- GOTOXY ." NUMBER OF RINGS ( maximum is 7, default-QUIT):"
#THEN
#IN
DUP 0= IF 7 EMIT EXIT THEN
BIGSCREEN? #IF
1 MAX 9 MIN
#ELSE
1 MAX 7 MIN
#THEN
>R
0 l/s 1- GOTOXY 65 SPACES
0 l/s 1- GOTOXY ." NUMBER OF HANOI TASKS (1-6, default 6):"
#IN DUP 0= IF DROP 6 THEN 1 MAX 6 MIN
0 l/s 1- GOTOXY 65 SPACES
0 l/s 1- GOTOXY ." NUMBER OF PRINTER TASKS (1-12, default 12):"
#IN DUP 0= IF DROP 12 THEN 1 MAX 12 MIN
0 l/s 1- GOTOXY 65 SPACES
0 l/s 1- GOTOXY ." PRINTER TASK AVERAGE 18ms WAITS (max 50, default 0):"
#IN 50 MIN 0 MAX
R>
;
VARIABLE MAXTASKS
0 0 IN/OUT
: TASK-COUNTER ( a task )
1 BACKGROUND
BEGIN
65 l/s 1- GOTOXY
11 FOREGROUND WAITING-TASKS 7 .R
12 FOREGROUND ACTIVE-TASKS DUP 3 .R
10 FOREGROUND MAXTASKS @ MAX DUP MAXTASKS ! 3 .R
5 WAIT ( about .1 sec updates )
AGAIN
;
' TASK-COUNTER TASK TASKCOUNT
: MAIN
INIT-TASKS
7 BACKGROUND
14 FOREGROUND
CLS
." MULTITASKING TOWER OF HANOI" CR
." Copyright (C) 1987 by Thomas Almy. All rights reserved." CR
." This unmodified program may be distributed freely." CR
." This program demonstrates the multitasking feature of ForthCMP," CR
." the Forth language compiler" CR CR
." The main task asks questions at the bottom of the display." CR
." The tower puzzle is solved via message passing among a selectable number" CR
." of tasks. The printing of the moves is done be a selectable number of tasks." CR
." The printer tasks can also have a variable amount of delay after each move." CR
." The lower left corner of the display contains status information produced by" CR
." a separate task 10 times per second. The three numbers are:" CR
8 SPACES ." tasks waiting for timer" CR
8 SPACES ." tasks that are running" CR
8 SPACES ." total tasks used in last iteration" CR CR
." Hitting Ctrl-Break will cause the program to abort and task status to be" CR
." displayed."
TASKCOUNT WAKE
BEGIN
GET-COMMAND
RUN-DOWN
?DUP WHILE
MAXTASKS OFF
CLS
>R DCOUNT ! PCOUNT ! HCOUNT !
R> SETUP NEXT-HANOI-TASK SEND-MESSAGE
REPEAT
BYE
;
INCLUDE FARMEM2
INCLUDE FORTHLIB
END